(FILECREATED "24-FEB-83 11:26:22" {PHYLUM}<GABRIEL>PUZZLE.;6 5683   

      changes to:  (VARS TYPEMAX)
		   (FNS FIT PLACE REMOVE! TRIAL START DEFINEPIECE FRESHPUZZLES)

      previous date: "17-FEB-83 10:03:35" {PHYLUM}<GABRIEL>PUZZLE.;4)


(* Copyright (c) 1982, 1983 by Xerox Corporation)

(PRETTYCOMPRINT PUZZLECOMS)

(RPAQQ PUZZLECOMS ((FILES (SYSLOAD COMPILED)
			  CMLARRAY)
		   (CONSTANTS SIZE TYPEMAX D CLASSMAX)
		   (FNS FIT PLACE REMOVE! TRIAL DEFINEPIECE START FRESHPUZZLES)
		   (MACROS CLASS PIECEMAX PUZZLE P PIECECOUNT)
		   (INITVARS (CLASS NIL)
			     (PIECEMAX NIL)
			     (PUZZLE NIL)
			     (P NIL)
			     (PIECECOUNT NIL)
			     (PUZZLETRACEFLG NIL))
		   (GLOBALVARS CLASS PIECEMAX PUZZLE P PIECECOUNT III PUZZLETRACEFLG)
		   (SPECVARS KOUNT)
		   (P (FRESHPUZZLES))))
(FILESLOAD (SYSLOAD COMPILED)
	   CMLARRAY)
(DECLARE: EVAL@COMPILE 

(RPAQQ SIZE 511)

(RPAQQ TYPEMAX 12)

(RPAQQ D 8)

(RPAQQ CLASSMAX 3)

(CONSTANTS SIZE TYPEMAX D CLASSMAX)
)
(DEFINEQ

(FIT
  (LAMBDA (I J)                                              (* JonL "16-FEB-83 14:50")
    (NOT (find K from 0 to (PIECEMAX I) suchthat (AND (P I K)
						      (PUZZLE (IPLUS J K)))))))

(PLACE
  (LAMBDA (I J)                                              (* JonL "16-FEB-83 21:07")
    (for K from 0 to (PIECEMAX I) do (if (P I K)
					 then (PASET T PUZZLE (IPLUS J K))))
    (16ASET (SUB1 (PIECECOUNT (CLASS I)))
	    PIECECOUNT
	    (CLASS I))
    (OR (find K from J to SIZE suchthat (NOT (PUZZLE K)))
	0)))

(REMOVE!
  (LAMBDA (I J)                                              (* JonL "16-FEB-83 21:07")
    (for K from 0 to (PIECEMAX I) do (if (P I K)
					 then (PASET NIL PUZZLE (IPLUS J K))))
    (16ASET (ADD1 (PIECECOUNT (CLASS I)))
	    PIECECOUNT
	    (CLASS I))))

(TRIAL
  (LAMBDA (J)                                                (* edited: "17-FEB-83 10:02")
    (bind (K ← 0) for I from 0 to TYPEMAX
       do (if (AND (NEQ 0 (PIECECOUNT (CLASS I)))
		   (FIT I J))
	      then (SETQ K (PLACE I J))
		   (if (OR (TRIAL K)
			   (ZEROP K))
		       then (AND PUZZLETRACEFLG (printout NIL T "Piece" .TAB "at" .TAB (ADD1 K)))
			    (add KOUNT 1)
			    (RETURN T)
		     else (REMOVE! I J)))
       finally (PROGN (add KOUNT 1)
		      NIL))))

(DEFINEPIECE
  (LAMBDA (ICLASS II JJ KK)                                  (* JonL "16-FEB-83 17:15")
    (PROG ((INDEX 0))
          (for I from 0 to II do (for J from 0 to JJ
				    do (for K from 0 to KK
					  do (SETQ INDEX (IPLUS I (ITIMES D (IPLUS J
										   (ITIMES D K)))))
					     (PASET T P III INDEX))))
          (16ASET ICLASS CLASS III)
          (16ASET INDEX PIECEMAX III)
          (if (NEQ III TYPEMAX)
	      then (add III 1)))))

(START
  (LAMBDA NIL                                                (* JonL "16-FEB-83 22:21")
    (for M from 0 to SIZE do (PASET T PUZZLE M))
    (for I from 1 to 5 do (for J from 1 to 5
			     do (for K from 1 to 5
				   do (PASET NIL PUZZLE (IPLUS I (ITIMES D (IPLUS J (ITIMES D K)))))))
	 )
    (for I from 0 to TYPEMAX do (for M from 0 to SIZE do (PASET NIL P I M)))
    (SETQ III 0)
    (DEFINEPIECE 0 3 1 0)
    (DEFINEPIECE 0 1 0 3)
    (DEFINEPIECE 0 0 3 1)
    (DEFINEPIECE 0 1 3 0)
    (DEFINEPIECE 0 3 0 1)
    (DEFINEPIECE 0 0 1 3)
    (DEFINEPIECE 1 2 0 0)
    (DEFINEPIECE 1 0 2 0)
    (DEFINEPIECE 1 0 0 2)
    (DEFINEPIECE 2 1 1 0)
    (DEFINEPIECE 2 1 0 1)
    (DEFINEPIECE 2 0 1 1)
    (DEFINEPIECE 3 1 1 1)
    (16ASET 13 PIECECOUNT 0)
    (16ASET 3 PIECECOUNT 1)
    (16ASET 1 PIECECOUNT 2)
    (16ASET 1 PIECECOUNT 3)
    (PROG ((M (IPLUS 1 (ITIMES D (IPLUS 1 D))))
	   (N 0)
	   (KOUNT 0))
          (if (FIT 0 M)
	      then (SETQ N (PLACE 0 M))
	    else (printout NIL T "Error"))
          (if (TRIAL N)
	      then (printout NIL T "Success in " KOUNT " trials.")
	    else (printout NIL T "Failure."))
          (TERPRI))))

(FRESHPUZZLES
  (LAMBDA NIL                                                (* JonL "16-FEB-83 21:12")
    (SETQ CLASS (MAKEARRAY (ADD1 TYPEMAX)
			   (QUOTE ELEMENTTYPE)
			   (QUOTE (MOD 65535))))
    (SETQ PIECEMAX (MAKEARRAY (ADD1 TYPEMAX)
			      (QUOTE ELEMENTTYPE)
			      (QUOTE (MOD 65535))))
    (SETQ PUZZLE (MAKEARRAY (IPLUS SIZE 2)))
    (SETQ P (MAKEARRAY (LIST (ADD1 TYPEMAX)
			     (IPLUS SIZE 2))))
    (SETQ PIECECOUNT (MAKEARRAY (IPLUS CLASSMAX 2)
				(QUOTE ELEMENTTYPE)
				(QUOTE (MOD 65535))))
    NIL))
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS CLASS MACRO ((I . REST)
  (16AREF CLASS I . REST)))

(PUTPROPS PIECEMAX MACRO ((I . REST)
  (16AREF PIECEMAX I . REST)))

(PUTPROPS PUZZLE MACRO ((I . REST)
  (PAREF PUZZLE I . REST)))

(PUTPROPS P MACRO ((I . REST)
  (PAREF P I . REST)))

(PUTPROPS PIECECOUNT MACRO ((I . REST)
  (16AREF PIECECOUNT I . REST)))
)

(RPAQ? CLASS NIL)

(RPAQ? PIECEMAX NIL)

(RPAQ? PUZZLE NIL)

(RPAQ? P NIL)

(RPAQ? PIECECOUNT NIL)

(RPAQ? PUZZLETRACEFLG NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS CLASS PIECEMAX PUZZLE P PIECECOUNT III PUZZLETRACEFLG)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(SPECVARS KOUNT)
)
(FRESHPUZZLES)
(PUTPROPS PUZZLE COPYRIGHT ("Xerox Corporation" 1982 1983))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1003 4888 (FIT 1013 . 1229) (PLACE 1231 . 1602) (REMOVE! 1604 . 1901) (TRIAL 1903 . 
2464) (DEFINEPIECE 2466 . 2989) (START 2991 . 4348) (FRESHPUZZLES 4350 . 4886)))))
STOP